home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / loader / oload.mod < prev    next >
Encoding:
Text File  |  1995-05-11  |  20.7 KB  |  793 lines
  1. (*$LargeVars:=TRUE *)(* Absolute addressing so A4 hasn't any special meaning *)
  2.  
  3. MODULE OLoad; (** SHML/cn 13-Jul-93 **)
  4. (*
  5.  OLoad is the Amiga Oberon Loader. It implements the loading and
  6.  relocating of modules.
  7.  
  8.  Additionally it provides runtime support functions for Oberon.
  9. *)
  10.  
  11. FROM SYSTEM IMPORT ADDRESS,ADR,ASSEMBLE,BITSET,BYTE,CAST,LOADREGS,REG,SAVEREGS,SETREG,SHIFT,TAG,WORD;
  12.  
  13. FROM OLoadData IMPORT
  14.  Absolute,CodeBase,Count,Entry,Module,Name,Size,TypeDescriptor
  15.  ,descSizeAligned,nameLen
  16.  ,module255
  17.  ,commandsEntryG,commandsEntryP,commandsNameG,commandsNameP,codeG,codeSizeG,codeSizeP
  18.  ,constG,constSizeG,constSizeP,dataG,dataSizeG,dataSizeP,entriesG,entryG
  19.  ,keyG,keyP,importsG,importsP,nameG,nameP,nextG,nextP
  20.  ,nofCommandsG,nofCommandsP,nofEntriesG,nofEntriesP,nofImportsG,nofImportsP
  21.  ,nofPointersG,nofPointersP,pointerG,refG,refP,refCntG,refCntP,refSizeG,refSizeP,tagP
  22.  ,tdExtensionLevelG,tdModuleP,tdNumberOfMethodsG,tdSizeG,tdSizeP,tdTagP
  23.  ,Address,AllocateMod,CompleteTypeDescs,DeallocateMod,EqualName,Fixup,GetName
  24.  ,MakeAbsolute,PutName,SetupPointers;
  25.  
  26. FROM OLoadDebug IMPORT
  27.  NewTrapStub,ResetTrapStub,ToModula,ToOberon;
  28.  
  29. IMPORT
  30.  Arguments,Arts,Break,DosD,DosL,ExecD,ExecL,Heap
  31.  ,P:PeekNPoke,SeqIO,str:String,T:Terminal,Terminator;
  32.  
  33. CONST
  34.  (*
  35.   return values of ThisMod
  36.  *)
  37.  done=0; fileNotFound=1; keyMismatch= 3; invalidObjFile=4;
  38.  commandNotFound=5; tooManyImports=6; notEnoughSpace=7;
  39.  
  40.  (*
  41.   return values of Free
  42.  *)
  43.  modNotFound=7; refCntNotZero=9;
  44.  
  45.  (*
  46.   implementation restrictions
  47.  *)
  48.  MaxImports=64;
  49.  
  50. (*
  51.  bufferSize for source file.
  52. *)
  53.  bufferSize=04000H;
  54.  
  55. VAR
  56.  modules:ADDRESS;
  57.  noSystem:BOOLEAN;
  58.  oberonModuleList:POINTER TO ADDRESS;
  59.  objFile:SeqIO.SeqKey;
  60.  oberonTerm:Terminator.Reference;
  61.  oberonTrapStub:LONGINT;
  62.  searchPath:ARRAY [0..255] OF CHAR;
  63.  
  64. (*
  65.  Some procedure for easier reading from object file
  66. *)
  67.  
  68. PROCEDURE Read():CHAR; BEGIN RETURN SeqIO.SeqInB(objFile); END Read;
  69. (* Read one byte from object file. *)
  70.  
  71. PROCEDURE ReadShort():INTEGER; BEGIN RETURN SeqIO.SeqInW(objFile); END ReadShort;
  72. (* Read two bytes from object file. *)
  73.  
  74. PROCEDURE ReadLong():LONGINT; BEGIN RETURN SeqIO.SeqInL(objFile); END ReadLong;
  75. (* Read four bytes from object file. *)
  76.  
  77. PROCEDURE ReadName(VAR name: ARRAY OF CHAR);
  78. (* Read a modulename of 24 bytes from object files. *)
  79. BEGIN SeqIO.SeqInCount(objFile,ADR(name),nameLen); END ReadName;
  80.  
  81. PROCEDURE ReadString(VAR name: ARRAY OF CHAR);
  82. (* Read a zero terminated string from object file. *)
  83. VAR i:INTEGER;
  84. BEGIN
  85.  i:=-1; REPEAT INC(i); SeqIO.SeqGetB(objFile,name[i]); UNTIL name[i]=0C;
  86. END ReadString;
  87.  
  88. PROCEDURE ReadBlock(block: Absolute; size:Size);
  89. (* Read a block of given length from object file. *)
  90. BEGIN SeqIO.SeqInCount(objFile,block,size); END ReadBlock;
  91.  
  92. PROCEDURE Check(byte:CHAR; VAR res:INTEGER);
  93. (* Check if current byte in objfile=byte; res:=done | invalidObjFile *)
  94. BEGIN
  95.  IF (res=done) & (byte=Read()) THEN res:=done; ELSE res:=invalidObjFile; END
  96. END Check;
  97.  
  98. (*-------*)
  99.  
  100. PROCEDURE Matches(VAR s0,s1:ARRAY OF CHAR): BOOLEAN;
  101. (*
  102.  TRUE, if s0, s1 match up to the third period
  103.  TRUE, if s0 is terminated, and the rest of s1 starts with a period
  104.  FALSE otherwise
  105. *)
  106. VAR
  107.  i,no:INTEGER;
  108.  ch:CHAR;
  109. BEGIN
  110.  i:=0; no:=0; ch:=s0[0];
  111.  WHILE (ch#0C) & (ch=s1[i]) DO
  112.   IF ch="." THEN INC(no); IF no=3 THEN RETURN TRUE END END;
  113.   INC(i); ch:=s0[i]
  114.  END;
  115.  RETURN (ch=0C) & (s1[i]=".")
  116. END Matches;
  117.  
  118. PROCEDURE Find(name:ARRAY OF CHAR; VAR mod:Module; VAR res:INTEGER);
  119. (*
  120.  find name in global module list, mod:=NIL | found module, res:=done | modNotFound
  121. *)
  122. BEGIN
  123.  mod:=modules;
  124.  WHILE (mod#NIL) & NOT(EqualName(mod,name)) DO mod:=nextG(mod); END;
  125.  IF mod=NIL THEN res:=modNotFound; ELSE res:=done; END
  126. END Find;
  127.  
  128. PROCEDURE Unlink(mod:Module);
  129. (* Remove the module from the singly linked list of modules. *)
  130. VAR
  131.  cur,prev:Module;
  132. BEGIN
  133.  IF modules=mod THEN
  134.   modules:=nextG(mod); nextP(mod,NIL);
  135.   IF oberonModuleList#NIL THEN
  136.    oberonModuleList^:=modules;
  137.   END;
  138.  ELSE
  139.   cur:=modules;
  140.   WHILE (cur#NIL) & (cur#mod) DO prev:=cur; cur:=nextG(cur); END;
  141.   IF cur#NIL THEN nextP(prev,nextG(cur)); nextP(cur,NIL); END
  142.  END;
  143. END Unlink;
  144.  
  145. PROCEDURE ErrMsg(res: INTEGER; n1,n2: ARRAY OF CHAR);
  146. BEGIN
  147.  CASE res OF
  148.  | done: T.WriteString("done\n");
  149.  | invalidObjFile: T.FormatS("Invalid object file %s\n", n1);
  150.  | keyMismatch:
  151.   T.FormatS("Call error: %s", n1); T.FormatS(" imports %s with bad key\n", n2);
  152.  | fileNotFound: T.FormatS("File not found: %s\n", n1);
  153.  | commandNotFound: T.WriteString(n1); T.FormatS(".%s command not found\n",n2)
  154.  | tooManyImports: T.FormatS("%s has too many imports\n", n1);
  155.  | refCntNotZero: T.FormatS("Reference count not zero: %s\n", n1)
  156.  | notEnoughSpace: T.WriteString("Not enough heap space\n");
  157.  ELSE T.FormatNr("Unrecognized error %d\n",res);
  158.  END;
  159. END ErrMsg;
  160.  
  161. PROCEDURE ThisMod(name:ARRAY OF CHAR; VAR module:Module; VAR res:INTEGER; VAR imported:ARRAY OF CHAR); FORWARD;
  162.  
  163. PROCEDURE ThisCommand(mod:Module; commandname:ARRAY OF CHAR; VAR adr:Absolute; VAR res:INTEGER);
  164. (* returns the adr of command commandname in mod, res:=done | commandNotFound *)
  165. VAR
  166.  i:Count;
  167.  name:Name;
  168.  nofCommands:Count;
  169. BEGIN
  170.  (* Search the command in the modules command table *)
  171.  i:=0; nofCommands:=nofCommandsG(mod);
  172.  LOOP
  173.   IF i>=nofCommands THEN EXIT; END;
  174.   commandsNameG(mod,i,name);
  175.   IF str.Compare(name,commandname)=0 THEN EXIT; END;
  176.   INC(i);
  177.  END;
  178.  IF i=nofCommands THEN
  179.   adr:=0; res:=commandNotFound;
  180.   nameG(mod,name);
  181.   IF noSystem THEN ErrMsg(res,name,commandname); END;
  182.  ELSE
  183.   adr:=codeG(mod)+commandsEntryG(mod,i); res:=done;
  184.  END
  185. END ThisCommand;
  186.  
  187. PROCEDURE FreeModule(mod:Module; all:BOOLEAN);
  188. (*
  189.  Unload mod and if requested all modules imported by this module.
  190. *)
  191. VAR
  192.  i:INTEGER;
  193.  imp:Module;
  194.  refCnt:Count;
  195. BEGIN
  196. (*
  197.  For each imported module, the reference count is decreased. If it is
  198.  zero, then that module is freed to, if all is TRUE. At the end the
  199.  module itself is removed from the module list.
  200. *)
  201.  FOR i:=1 TO nofImportsG(mod) DO
  202.   imp:=importsG(mod,i);
  203.   refCnt:=refCntG(imp);
  204.   DEC(refCnt);
  205.   refCntP(imp,refCnt);
  206.   IF (refCnt=0) & all THEN FreeModule(imp,TRUE) END;
  207.  END;
  208.  Unlink(mod);
  209. END FreeModule;
  210.  
  211. PROCEDURE Free(name:ARRAY OF CHAR; all:BOOLEAN; VAR res:INTEGER);
  212. (* unload module name and all imports, res:=done | refCntNotZero *)
  213. VAR
  214.  mod:Module;
  215. BEGIN
  216. (*
  217.  Freeing is only done, if the module exists in the module list and
  218.  the reference count of the module is zero.
  219. *)
  220.  Find(name,mod,res);
  221.  IF res=done THEN
  222.   IF refCntG(mod)>0 THEN res:=refCntNotZero;
  223.   ELSE FreeModule(mod,all); res:=done;
  224.   END
  225.  END
  226. END Free;
  227.  
  228. PROCEDURE CallOberon0(ud{0}:Terminator.UserData);
  229. (*
  230.  Call an Oberon procedure. Performs necessary save of registers.
  231. *)
  232. VAR
  233.  data:ADDRESS;
  234.  proc:PROC;
  235.  dump:POINTER TO ARRAY [0..20] OF BYTE;
  236. BEGIN
  237.  data:=ud;
  238.  proc:=CAST(PROC,data);
  239.  dump:=data;
  240.  ToOberon;
  241.  SAVEREGS(BITSET{0..14});
  242.  SETREG(16B,REG(15B));
  243.  proc();
  244.  LOADREGS(BITSET{0..14});
  245.  ToModula;
  246. END CallOberon0;
  247.  
  248. PROCEDURE CallOberon2(ud{0}:Terminator.UserData);
  249. (*
  250.  Call an Oberon procedure. Performs necessary save of registers.
  251. *)
  252. VAR
  253.  data:ADDRESS;
  254.  proc:PROC;
  255.  dump:POINTER TO ARRAY [0..20] OF BYTE;
  256.  dummy:INTEGER;
  257. BEGIN
  258.  data:=ud;
  259.  proc:=CAST(PROC,data);
  260.  dump:=data;
  261.  ToOberon;
  262.  SAVEREGS(BITSET{0..14});
  263.  SETREG(16B,REG(15B));
  264.  proc();
  265.  LOADREGS(BITSET{0..14});
  266.  ToModula;
  267. END CallOberon2;
  268.  
  269. PROCEDURE CallOberon(ud{0}:Terminator.UserData);
  270. (*
  271.  Call an Oberon procedure. Performs necessary save of registers.
  272. *)
  273. VAR
  274.  dummy:INTEGER;
  275. BEGIN
  276.  IF (ADR(dummy) MOD 4)#0 THEN CallOberon0(ud);
  277.  ELSE CallOberon2(ud);
  278.  END;
  279. END CallOberon;
  280.  
  281. PROCEDURE CallTrapStub;
  282. BEGIN
  283.  CallOberon(oberonTrapStub);
  284. END CallTrapStub;
  285.  
  286. PROCEDURE Amiga(data{3}:Absolute);
  287. (*
  288.  This procedure is installed into a procedure variable of module Amiga,
  289.  and allows to execute some loader functions from Oberon.
  290. *)
  291. (*$ StackChk:=FALSE *)
  292.  
  293.  PROCEDURE GetData(index:SHORTCARD):LONGCARD;
  294.  BEGIN
  295.   RETURN P.GetLongB(data,index*4);
  296.  END GetData;
  297.  
  298. VAR
  299.  adrPtr,importedPtr,modPtr,modulesPtr,namePtr,procPtr,resPtr,sizePtr:Absolute;
  300.  adr:ADDRESS;
  301.  all:BOOLEAN;
  302.  cond:BOOLEAN;
  303.  err:LONGINT;
  304.  i:INTEGER;
  305.  imported:Name;
  306.  mod:Module;
  307.  msg:ADDRESS;
  308.  name:Name;
  309.  proc:Absolute;
  310.  size:Size;
  311.  res:INTEGER;
  312. (*$ LoadA4:=TRUE *)
  313. BEGIN
  314.  ToModula;
  315.  CASE GetData(0) OF
  316.  
  317.  | 0: (* InstallNew(proc:NewProc); *)
  318.   (* Transfer address of Kernel.New, so it can be used in Fixup *)
  319.   module255[0]:=GetData(1);
  320.  
  321.  | 1: (* InstallSysNew(proc:NewProc); *)
  322.   (* Transfer address of Kernel.SysNew, so it can be used in Fixup *)
  323.   module255[1]:=GetData(1);
  324.  
  325. (* 2 no more *)
  326.  
  327.  | 3: (* Terminate() *)
  328.   (* Terminate Oberon *)
  329.   Arts.Terminate();
  330.  
  331.  | 4: (* ThisMod(name:ARRAY OF CHAR; VAR module:Module; VAR res:INTEGER; VAR modules:Module; VAR imported:ARRAY OF CHAR); *)
  332.   (* Load a new module *)
  333.   namePtr:=GetData(1);
  334.   modPtr:=GetData(2);
  335.   resPtr:=GetData(3);
  336.   modulesPtr:=GetData(4);
  337.   importedPtr:=GetData(5);
  338.   GetName(namePtr,0,name);
  339.   ThisMod(name,mod,res,imported);
  340.   PutName(importedPtr,0,imported);
  341.   P.PutLongB(modPtr,0,mod);
  342.   P.PutWordB(resPtr,0,res);
  343.   P.PutLongB(modulesPtr,0,modules);
  344.  
  345.  | 5: (* ThisCommand(mod:Module; cmdname:ARRAY OF CHAR; VAR adr:Absolute; VAR res:INTEGER); *)
  346.   (* Get address of a command *)
  347.   mod:=GetData(1);
  348.   namePtr:=GetData(2);
  349.   procPtr:=GetData(3);
  350.   resPtr:=GetData(4);
  351.   GetName(namePtr,0,name);
  352.   ThisCommand(mod,name,proc,res);
  353.   P.PutLongB(procPtr,0,proc);
  354.   P.PutWordB(resPtr,0,res);
  355.  
  356.  | 6: (* Free(name:ARRAY OF CHAR; all:BOOLEAN; VAR res:INTEGER; VAR modules:Module); *)
  357.   (* Free a module *)
  358.   namePtr:=GetData(1);
  359.   all:=GetData(2)#0;
  360.   resPtr:=GetData(3);
  361.   modulesPtr:=GetData(4);
  362.   GetName(namePtr,0,name);
  363.   Free(name,all,res);
  364.   P.PutWordB(resPtr,0,res);
  365.   P.PutLongB(modulesPtr,0,modules);
  366.  
  367.  | 7: (* Allocate(VAR adr:LONGINT; size:LONGINT); *)
  368.   adrPtr:=GetData(1);
  369.   adr:=P.GetLongB(adrPtr,0);
  370.   size:=GetData(2);
  371.   Heap.Allocate(adr,size);
  372.   P.PutLongB(adrPtr,0,adr);
  373.  
  374.  | 8: (* TermProcedure(proc:PROCEDURE); *)
  375.   proc:=GetData(1);
  376.   oberonTerm:=Terminator.Add(CallOberon,proc,oberonTerm);
  377.   Arts.Assert(oberonTerm#Terminator.newReference,ADR("Terminator problem!"));
  378.  
  379. (* 9 no more *)
  380.  
  381.  | 10: (* Assert(cond:BOOLEAN; msg:ARRAY OF CHAR); *)
  382.   cond:=GetData(1)#0;
  383.   msg:=GetData(2);
  384.   Arts.Assert(cond,msg);
  385.  
  386. (* 11 no more *)
  387.  
  388.  | 12: (* Deallocate(adr:LONGINT; size:LONGINT); *)
  389.   adr:=GetData(1);
  390.   size:=GetData(2);
  391.   Heap.Deallocate(adr);
  392.  | 13: (* InstallModuleList(modList:LONGINT); *)
  393.   adr:=GetData(1);
  394.   oberonModuleList:=ADDRESS(adr);
  395.  | 14: (* InstallTrapHandler(p: PROCEDURE); *)
  396.   oberonTrapStub:=GetData(1);
  397.   NewTrapStub(ADR(CallTrapStub));
  398.  | 15: (* ResetTrapStub; *)
  399.   ResetTrapStub;
  400.  | 16: (* GetErrorFrame(VAR err: ErrorFrame); *)
  401.   err:=GetData(1);
  402.   P.PutLongB(err,0,Arts.errorFrame.pc);
  403.   P.PutLongB(err,4,Arts.errorFrame.aRegs[15]); (* stack pointer *)
  404.   P.PutLongB(err,8,Arts.errorFrame.aRegs[13]); (* frame pointer *)
  405.   P.PutLongB(err,12,ORD(Arts.errorFrame.error));
  406.   CASE Arts.errorFrame.error OF
  407.   | Arts.trap:
  408.    P.PutLongB(err,16,Arts.errorFrame.trapNr);
  409.   | Arts.exception:
  410.    P.PutLongB(err,16,CAST(LONGINT,Arts.errorFrame.exceptionMask));
  411.   | Arts.system:
  412.    P.PutLongB(err,16,ORD(Arts.errorFrame.sysErr));
  413.   ELSE
  414.    P.PutLongB(err,16,0);
  415.   END;
  416.  | 17:(* GetSearchPath(VAR searchPath:ARRAY OF CHAR); *)
  417.   adr:=GetData(1);
  418.   size:=GetData(2);
  419.   i:=0;
  420.   WHILE (i<size-1) & (searchPath[i]#0C) DO
  421.    P.PutByte(adr,i,SHORTCARD(searchPath[i]));
  422.    INC(i);
  423.   END;
  424.   P.PutByte(adr,i,0);
  425.  | 18: (* SystemHere(); *)
  426.   noSystem:=FALSE;
  427.  END;
  428.  ToOberon;
  429. END Amiga;
  430.  
  431. (*$ POP StackChk *)
  432.  
  433. PROCEDURE InitAmiga(mod:Module);
  434. (*
  435.  Install Amiga in procedure variable loaderCall of module Amiga.
  436. *)
  437. VAR
  438.  p:POINTER TO PROCEDURE(LONGINT{3});
  439. BEGIN
  440.  (*
  441.   Knowing the current address of variable loaderCall, we patch it,
  442.   to point to procedure Amiga. As the position of this variable
  443.   can change, we patch also two guard variables, which are tested
  444.   in Module Amiga.
  445.  *)
  446.  p:=ADR(Amiga);
  447.  P.PutLongB(codeG(mod),-4,ADDRESS(002468ACEH)); (* guard1 *)
  448.  P.PutLongB(codeG(mod),-8,ADDRESS(p));          (* loaderCall *)
  449.  P.PutLongB(codeG(mod),-12,ADDRESS(013579BDFH));(* guard2 *)
  450. END InitAmiga;
  451.  
  452. PROCEDURE LoadModule(VAR mod:Module; VAR res:INTEGER; VAR imported:ARRAY OF CHAR);
  453. (*
  454.  Load module from open object file. The structure of the object file is
  455.  
  456.   ObjFile=Header Entries Commands Pointers Imports Const Code References.
  457.  
  458.   Header=0F1H version refPos refLen
  459.    numOfEntries numOfCommands numOfPointers numOfImports
  460.    link dataSize constSize codeSize key modName.
  461.  
  462.   version=36H.
  463.  
  464.   refPos,refLen,dataSize,constSize,codeSize,key=LONGCARD.
  465.  
  466.   numOfEntries,numOfCommands,numOfPointers,numOfImports,link=CARDINAL.
  467.  
  468.   modName=ARRAY [0..23] OF CHAR.
  469.  
  470.   name={ BYTE[1..255] } 0H.
  471.  
  472.   Entries=82H {entry}.
  473.  
  474.   Commands=83H {name entry}.
  475.  
  476.   Pointers=84H {offset}. (* global pointers, needed for the garbage collector *)
  477.  
  478.   Imports=85H {key name}.
  479.  
  480.   Const=86H {byte}.
  481.  
  482.   Code=87H {byte}.
  483.  
  484.   References=88H point "$\0" {variable} {point ["(" name ")"] name {variable}}.
  485.  
  486.   point=0F8X pcPos.
  487.  
  488.   variable=mode form adr name.
  489.  
  490.   pcPos,adr='variable length number'.
  491.  
  492. *)
  493.  
  494. VAR
  495.  constSize, dataSize, codeSize, refPos, refSize, descSize, size: LONGINT;
  496.  constAdr:LONGINT;
  497.  dummyS:ARRAY [0..1] OF CHAR;
  498.  dummyI:INTEGER;
  499.  entry:Entry;
  500.  i, j: LONGINT;
  501.  imp: Module;
  502.  import: ARRAY [0..MaxImports-1] OF RECORD name: Name; key: LONGINT END;
  503.  link, nofEntries, nofCommands, nofPtrs, nofImports: INTEGER;
  504.  name:Name;
  505.  proc:PROC;
  506.  tagbuf:ARRAY [0..9] OF LONGINT;
  507. BEGIN
  508.  res:=done;
  509.  Check(CHAR(0F1H),res); Check("6",res); (* Verify it's an object file version "6" *)
  510.  IF res=done THEN
  511.   (*
  512.    Read first part of header
  513.   *)
  514.   refPos:=ReadLong(); refSize:=ReadLong();
  515.   nofEntries:=ReadShort(); nofCommands:=ReadShort();
  516.   nofPtrs:=ReadShort(); nofImports:=ReadShort();
  517.  
  518.   IF nofImports >= MaxImports THEN res:=tooManyImports END;
  519.   link:=ReadShort(); dataSize:=ReadLong();
  520.   constSize:=ReadLong(); codeSize:=ReadLong();
  521.  
  522.   (*
  523.    As soon as the size is known, we can allocate the memory for this
  524.    module.
  525.   *)
  526.   mod:=AllocateMod(nofEntries,nofCommands,nofPtrs,nofImports,constSize,dataSize,codeSize,refSize);
  527.  
  528.   IF mod=NIL THEN
  529.    res:=notEnoughSpace;
  530.    IF noSystem THEN ErrMsg(res,"",""); END;
  531.    RETURN; (* !!!!!!!!!!!!!!!!!!!!!!!! procedure termination !!!!!!!!!!!!!!!!!! *)
  532.   END;
  533.   INC(mod,4); (* Adjust pointer, so that start of block is at offset -4 *)
  534.  
  535.   tagP(mod,1); (* set mark bit in tag *)
  536.  
  537.   refCntP(mod,0);
  538.   (*
  539.    How many times, this module is imported. On module load time there
  540.    is of course nobody who already imports this module.
  541.   *)
  542.  
  543.   nofEntriesP(mod,nofEntries); (* Entries = exported procedures (?) *)
  544.   nofCommandsP(mod,nofCommands);(* Commands = user callable procedures (M.P) *)
  545.   nofPointersP(mod,nofPtrs);   (* Pointers = global pointers (used by Garbage Collector) *)
  546.   nofImportsP(mod,nofImports); (* Imports = imported modules *)
  547.  
  548.   dataSizeP(mod,dataSize);     (* Data = global variables *)
  549.   constSizeP(mod,constSize);   (* Const = real and strings constants *)
  550.   codeSizeP(mod,codeSize);     (* Code = code *)
  551.   refSizeP(mod,refSize);       (* Ref = information for trap viewer *)
  552.  
  553.   keyP(mod,ReadLong());        (* Key = time stamp of symbol file generation *)
  554.   ReadName(name);              (* Name = module name *)
  555.   nameP(mod,name);
  556.  
  557.   SetupPointers(mod);          (* set entry .. ref pointers *)
  558.  
  559.   Check(CHAR(82H), res);       (* Entries *)
  560.   IF res=done THEN
  561.    ReadBlock(entryG(mod), 4*nofEntriesG(mod));
  562.   END;
  563.  
  564.   Check(CHAR(83H), res);       (* Commands *)
  565.   IF res=done THEN
  566.    i:=0;
  567.    WHILE i < nofCommandsG(mod) DO
  568.     ReadString(name);
  569.     entry:=ReadLong();
  570.     commandsNameP(mod,i,name);
  571.     commandsEntryP(mod,i,entry);
  572.     INC(i);
  573.    END;
  574.   END;
  575.  
  576.   Check(CHAR(84H), res);       (* Pointers *)
  577.   IF res=done THEN
  578.    ReadBlock(pointerG(mod), 4*nofPointersG(mod));
  579.   END;
  580.  
  581.   Check(CHAR(85H), res);       (* Imports *)
  582.   IF res=done THEN
  583.    i:=1;                       (* own module inserted later *)
  584.    WHILE i <= nofImportsG(mod) DO
  585.     import[i].key:=ReadLong();
  586.     ReadString(import[i].name);
  587.     INC(i)
  588.    END;
  589.   END;
  590.  
  591.   Check(CHAR(86H), res);       (* Constants *)
  592.   IF res=done THEN
  593.    ReadBlock(constG(mod), constSizeG(mod));
  594.   END;
  595.  
  596.   Check(CHAR(87H), res);       (* Code *)
  597.   IF res=done THEN
  598.    ReadBlock(codeG(mod), codeSizeG(mod));
  599.   END;
  600.  
  601.   Check(CHAR(88H), res);       (* Ref *)
  602.   IF res=done THEN
  603.    ReadBlock(refG(mod), refSizeG(mod));
  604.    nameG(mod,name);
  605.   END;
  606.  
  607.   SeqIO.CloseSeq(objFile);
  608.  
  609.   j:=1;
  610.   IF res=done THEN
  611.    importsP(mod,0,mod);
  612.    WHILE (j <= nofImportsG(mod)) & (res=done) DO
  613.     ThisMod(import[j].name,imp,res,imported);
  614.     IF res=done THEN
  615.      importsP(mod,j,imp);
  616.      refCntP(imp,refCntG(imp)+1);
  617.      IF import[j].key#keyG(imp) THEN
  618.       res:=keyMismatch;
  619.       nameG(mod,name);
  620.       str.Copy(imported,import[j].name);
  621.       IF noSystem THEN ErrMsg(res,name,import[j].name); END;
  622.      END;
  623.      INC(j)
  624.     ELSE
  625.      importsP(mod,j,0);
  626.     END;
  627.    END
  628.   END;
  629.   IF res=done THEN
  630.    Fixup(mod,link);
  631.    CompleteTypeDescs(mod);
  632.    nextP(mod,modules);
  633.    modules:=mod;
  634.    IF oberonModuleList#NIL THEN
  635.     oberonModuleList^:=modules;
  636.    END;
  637.    IF EqualName(mod,"Amiga") THEN
  638.     InitAmiga(mod);
  639.    END;
  640.    ExecL.CacheClearU;
  641.    CallOberon(codeG(mod));
  642.   ELSE
  643.    WHILE j > 1 DO
  644.     DEC(j);
  645.     imp:=importsG(mod,j);
  646.     IF imp#0 THEN
  647.      refCntP(imp,refCntG(imp)-1);
  648.     END;
  649.    END;
  650.    DeallocateMod(mod);
  651.    Unlink(mod);
  652.   END;
  653.  END;
  654. END LoadModule;
  655.  
  656. PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
  657. BEGIN
  658.  dest[0]:=0C;
  659.  IF DosL.AddPart(ADR(dest),ADR(dir),HIGH(dest)+1) THEN END;
  660.  IF DosL.AddPart(ADR(dest),ADR(name),HIGH(dest)+1) THEN END;
  661. END MakeFileName;
  662.  
  663.  PROCEDURE ThisMod(name: ARRAY OF CHAR; VAR module:Module; VAR res: INTEGER; VAR imported:ARRAY OF CHAR);
  664.  (* returns the module descriptor to name, res:=done | error code *)
  665.  VAR
  666.   fname: ARRAY [0..nameLen+4] OF CHAR;
  667.   path: ARRAY [0..255] OF CHAR;
  668.   i: INTEGER;
  669.  BEGIN
  670.   Find(name,module,res);
  671.   IF res=modNotFound THEN (* module not yet loaded *)
  672.    i:=-1; REPEAT INC(i); fname[i]:=name[i] UNTIL (name[i]=0C) OR (i=nameLen);
  673.    fname[i]:="."; fname[i+1]:="O"; fname[i+2]:="b"; fname[i+3]:="j"; fname[i+4]:=0C;
  674.    IF SeqIO.OpenSeqIn(objFile,fname,bufferSize) THEN
  675.     res:=done;
  676.    ELSE
  677.     MakeFileName(searchPath, fname, path);
  678.     IF SeqIO.OpenSeqIn(objFile,path,bufferSize) THEN res:=done;
  679.     ELSE
  680.      res:=fileNotFound;
  681.      IF noSystem THEN ErrMsg(res,path,""); END;
  682.     END;
  683.    END;
  684.    IF res=done THEN LoadModule(module,res,imported) END
  685.   END;
  686.  END ThisMod;
  687.  
  688. (*********************************)
  689.  
  690. VAR
  691.   process: DosD.ProcessPtr;
  692.   oldExceptCode: PROC;
  693.   oldExceptData:LONGINT;
  694.  
  695. (*$ SaveA4:=TRUE *) (* VERY IMPORTANT, save A4!!! *)
  696. PROCEDURE ExceptionHandler;
  697. VAR
  698.   inDos: BOOLEAN;
  699.   oldD0: LONGINT;
  700. BEGIN
  701.   oldD0:=REG(0);
  702.   ASSEMBLE(
  703.     MOVE.L    A1,A4 (* sonst kein Exec oder process^. ...! *)
  704.   END);
  705.   ExecL.Forbid; (* exclusive access to signals! *)
  706.   WITH process^.task DO
  707.     inDos:=ExecD.sigDos IN (sigWait/sigRecvd);
  708.     (* sigWait / sigReceived  X=sigDos IN, 0 not
  709.      *    0         0         no Dos call pending, should be no problem
  710.      *    X         0         in Dos waiting for answer, return quietly
  711.      *    0         X         in Dos(?) answer just received, curious
  712.      *    X         X         just finished dos call, remove message
  713.      *)
  714.   END;
  715.   ExecL.Permit;
  716.   IF ~inDos THEN
  717.     T.WriteString("CTRL-C terminates\n");
  718.     (* get any pending message *)
  719.     SETREG(0,ExecL.GetMsg(ADR(process^.msgPort)));
  720.     Break.ExitBreak;
  721.   ELSE
  722.     T.WriteString("CTRL-C can't terminate\n");
  723.   END;
  724.   SETREG(0,oldD0) (* reenable exception -> [RKM] *)
  725. END ExceptionHandler;
  726.  
  727. PROCEDURE InstallException;
  728. BEGIN
  729.   ExecL.Forbid;
  730.   process^.task.exceptCode:=ExceptionHandler;
  731.   process^.task.exceptData:=REG(4+8);
  732.   SETREG(0,ExecL.SetSignal(Break.NoBreak,Break.FullBreak)); (* alle lschen! *)
  733.   SETREG(0,ExecL.SetExcept(Break.CBreak,Break.CBreak));
  734.   ExecL.Permit;
  735. END InstallException;
  736.  
  737. PROCEDURE RemoveException;
  738. BEGIN
  739.   ExecL.Forbid;
  740.   SETREG(0,ExecL.SetExcept(Break.NoBreak,Break.CBreak));
  741.   process^.task.exceptCode:=oldExceptCode;
  742.   process^.task.exceptData:=oldExceptData;
  743.   ExecL.Permit;
  744. END RemoveException;
  745.  
  746. (*********************************)
  747.  
  748. VAR
  749.  command:LONGINT;
  750.  imported:Name;
  751.  len:INTEGER;
  752.  mod:Module;
  753.  oldLock:DosD.FileLockPtr;
  754.  res:INTEGER;
  755.  st:ARRAY [0..255] OF CHAR;
  756.  task:ExecD.TaskPtr;
  757. BEGIN
  758.  oldLock:=DosL.CurrentDir(DosL.Lock(ADR(""),DosD.sharedLock));
  759.  oberonTerm:=Terminator.newReference;
  760.  task:=ExecL.FindTask(NIL);
  761.  process:=ADDRESS(task);
  762.  IF ExecL.SetTaskPri(task,-4)=0 THEN END;
  763.  IF DosL.SetProgramName(ADR("Oberon4Amiga")) THEN END;
  764.  task^.node.name:=ADR("Oberon4Amiga");
  765.  
  766.  modules:=NIL;
  767.  oberonModuleList:=NIL;
  768.  noSystem:=TRUE;
  769.  InstallException;
  770.  
  771.  IF Arguments.NumArgs()#1 THEN
  772.   T.WriteString("Usage: OLoad searchAssign\n");
  773.   RETURN;
  774.  ELSE
  775.   Arguments.GetArg(1,searchPath,len);
  776.  END;
  777.  
  778.  ThisMod("Kernel\o",mod,res,imported);
  779.  IF res=done THEN
  780.   ThisMod("Amiga\o",mod,res,imported);
  781.   IF res=done THEN
  782.    ThisCommand(mod,"Loop\o",command,res);
  783.    IF res=done THEN
  784.     CallOberon(command);
  785.    END;
  786.   END;
  787.  END;
  788.  
  789. CLOSE
  790.  RemoveException;
  791.  IF oldLock#NIL THEN DosL.UnLock(DosL.CurrentDir(oldLock)); END;
  792. END OLoad.
  793.